home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / boxer / boxer.lha / keys1.lisp < prev    next >
Encoding:
Text File  |  1993-07-17  |  9.5 KB  |  327 lines

  1. ;; -*- Mode:LISP; Package:(BOXER GLOBAL 1000); Base:8.; Fonts:CPTFONT -*-
  2.  
  3. ;;; (C) Copyright 1983-1985 Massachusetts Institute of Technology
  4. ;;;
  5. ;;; Permission to use, copy, modify, distribute, and sell this software
  6. ;;; and its documentation for any purpose is hereby granted without fee,
  7. ;;; provided that the above copyright notice appear in all copies and that
  8. ;;; both that copyright notice and this permission notice appear in
  9. ;;; supporting documentation, and that the name of M.I.T. not be used in
  10. ;;; advertising or publicity pertaining to distribution of the software
  11. ;;; without specific, written prior permission.  M.I.T. makes no
  12. ;;; representations about the suitability of this software for any
  13. ;;; purpose.  It is provided "as is" without express or implied warranty.
  14. ;;;
  15.  
  16.  
  17. ;;; Defines all the "normal" (no ctrl- or meta- or super- or...) keys to be self inserting
  18. #.
  19. (LET ((VANILLA-KEY-CODES-NOT-TO-DEFINE '(#/| #/[ #/] #/{ #/})))
  20.     `(PROGN 'COMPILE
  21.       . ,(LOOP FOR KEY-CODE FROM 0 TO #O177
  22.            UNLESS  (OR (MEMQ KEY-CODE VANILLA-KEY-CODES-NOT-TO-DEFINE)
  23.                (AND (>= KEY-CODE 141) (<= KEY-CODE 172)))
  24.            COLLECT `(DEFBOXER-FUNCTION ,(LOOKUP-KEY-NAME KEY-CODE) COM-SELF-INSERT))))
  25.  
  26. ;;; Defines all the "control" (ctrl-, meta-, or ctrl-meta- ) number keys to act as a numeric
  27. ;;; argument
  28.  
  29. #.
  30. `(PROGN 'COMPILE
  31.     . ,(LOOP FOR CONTROL-BITS FROM 1 TO 3
  32.          APPEND (LOOP FOR KEY-CODE FROM (DPB CONTROL-BITS %%KBD-CONTROL-META 60)
  33.                                TO   (DPB CONTROL-BITS %%KBD-CONTROL-META 71)
  34.                   COLLECT `(DEFBOXER-FUNCTION ,(LOOKUP-KEY-NAME KEY-CODE) 
  35.                      COM-INCREMENT-NUMERIC-ARG))))
  36.  
  37.  
  38. (DEFBOXER-FUNCTION BU:CTRL-G-KEY COM-ABORT)
  39.  
  40. (DEFBOXER-FUNCTION BU:SPACE-KEY COM-SPACE)
  41.  
  42. (DEFBOXER-FUNCTION BU:RETURN-KEY COM-RETURN)
  43.  
  44. (DEFBOXER-FUNCTION BU:QUOTE-KEY COM-QUOTE-SELF-INSERT)
  45.  
  46. (DEFBOXER-FUNCTION BU:CTRL-Q-KEY COM-QUOTE-SELF-INSERT)
  47.  
  48. (DEFBOXER-FUNCTION BU:CTRL-O-KEY COM-OPEN-LINE)
  49.                         
  50. (DEFBOXER-FUNCTION BU:RUBOUT-KEY COM-RUBOUT)
  51.  
  52. (DEFBOXER-FUNCTION BU:CTRL-D-KEY COM-DELETE)
  53.  
  54. (DEFBOXER-FUNCTION BU:CTRL-F-KEY COM-FORWARD-CHA)
  55.  
  56. (DEFBOXER-FUNCTION BU:CTRL-B-KEY COM-BACKWARD-CHA)
  57.  
  58. (DEFBOXER-FUNCTION BU:META-F-KEY COM-FORWARD-WORD)
  59.  
  60. (DEFBOXER-FUNCTION BU:META-B-KEY COM-BACKWARD-WORD)
  61.  
  62. (DEFBOXER-FUNCTION BU:CTRL-N-KEY COM-NEXT-ROW)
  63.  
  64. (DEFBOXER-FUNCTION BU:CTRL-P-KEY COM-PREVIOUS-ROW)
  65.  
  66. (DEFBOXER-FUNCTION BU:CTRL-A-KEY COM-BEGINNING-OF-ROW)
  67.  
  68. (DEFBOXER-FUNCTION BU:CTRL-E-KEY COM-END-OF-ROW)
  69.  
  70. (DEFBOXER-FUNCTION BU:META-<-KEY COM-BEGINNING-OF-BOX)
  71.  
  72. (DEFBOXER-FUNCTION BU:META->-KEY COM-END-OF-BOX)
  73.  
  74. (DEFBOXER-FUNCTION BU:CTRL-V-KEY COM-SCROLL-DN-ONE-SCREEN-BOX)
  75.  
  76. (DEFBOXER-FUNCTION BU:META-V-KEY COM-SCROLL-UP-ONE-SCREEN-BOX)
  77.  
  78. (DEFBOXER-FUNCTION BU:CTRL-K-KEY COM-KILL-TO-END-OF-ROW)
  79.  
  80. ;;; fonts
  81. (DEFBOXER-FUNCTION BU:CTRL-I-KEY COM-ITALICS-FONT-CHA)
  82.  
  83. (DEFBOXER-FUNCTION BU:META-I-KEY COM-ITALICS-FONT-WORD)
  84.  
  85. (DEFBOXER-FUNCTION BU:CTRL-M-KEY COM-BOLDFACE-FONT-CHA)
  86.  
  87. (DEFBOXER-FUNCTION BU:META-M-KEY COM-BOLDFACE-FONT-WORD)
  88.  
  89. ;;; and case
  90. (DEFBOXER-FUNCTION META-U-KEY COM-UPPERCASE-WORD)
  91.  
  92. (DEFBOXER-FUNCTION META-L-KEY COM-LOWERCASE-WORD)
  93.  
  94. ;;; search
  95.  
  96. (DEFBOXER-FUNCTION CTRL-S-KEY COM-FORWARD-FLAT-SEARCH)
  97.  
  98. (DEFBOXER-FUNCTION CTRL-R-KEY COM-BACKWARD-FLAT-SEARCH)
  99.  
  100. (DEFBOXER-FUNCTION META-S-KEY COM-FORWARD-DEEP-SEARCH)
  101.  
  102. (DEFBOXER-FUNCTION META-R-KEY COM-BACKWARD-DEEP-SEARCH)
  103.  
  104. ;temporarily removed until it does saving
  105. ;(DEFBOXER-FUNCTION BU:META-K-KEY ()
  106. ;  (COM-KILL-TO-END-OF-BOX))
  107.  
  108. (DEFBOXER-FUNCTION BU:CTRL-Y-KEY COM-YANK)
  109.  
  110. (defboxer-function bu:ctrl-meta-y-key com-yank-no-copy)
  111.  
  112. ;doesn't put the stuff on the screen -- just rotates it.
  113. (DEFBOXER-FUNCTION BU:META-Y-KEY COM-ROTATE-KILL-BUFFER)
  114.                      
  115. (DEFBOXER-FUNCTION BU:CTRL-META-B-KEY COM-BOXIFY-REGION)
  116.  
  117. (DEFBOXER-FUNCTION BU:CTRL-L-KEY COM-FORCE-REDISPLAY)
  118.  
  119. (DEFBOXER-FUNCTION BU:BREAK-KEY COM-BREAK)
  120.  
  121. ;;;Regions
  122. (DEFBOXER-FUNCTION BU:CTRL-@-KEY COM-DEFINE-REGION)
  123.  
  124. (DEFBOXER-FUNCTION BU:META-@-KEY COM-INSTALL-REGION)
  125.  
  126. (DEFBOXER-FUNCTION BU:CTRL-W-KEY COM-KILL-REGION)
  127.  
  128. #+3600
  129. (DEFBOXER-FUNCTION BU:CIRCLE-KEY COM-NAME-BOX)
  130. #+EXPLORER
  131. (DEFBOXER-FUNCTION BU:F3-KEY     COM-NAME-BOX)
  132.  
  133. #+CADR
  134. (DEFBOXER-FUNCTION BU:HAND-DOWN-KEY COM-BUG)
  135. #+3600
  136. (DEFBOXER-FUNCTION BU:SCROLL-KEY    COM-BUG)
  137. #+EXPLORER
  138. (DEFBOXER-FUNCTION BU:F4-KEY        COM-BUG)
  139.  
  140. (DEFBOXER-FUNCTION BU:CLEAR-INPUT-KEY COM-TOGGLE-BOX-TYPE)
  141.  
  142. (DEFBOXER-FUNCTION BU:{-KEY COM-MAKE-AND-ENTER-DATA-BOX)
  143.  
  144. (DEFBOXER-FUNCTION BU:}-KEY COM-EXIT-BOX)
  145.  
  146. (DEFBOXER-FUNCTION BU:CTRL-{-KEY COM-ENTER-BOX)
  147.  
  148. (DEFBOXER-FUNCTION BU:CTRL-}-KEY COM-EXIT-BOX)
  149.  
  150. (DEFBOXER-FUNCTION BU:[-KEY COM-MAKE-AND-ENTER-BOX)
  151.  
  152. (DEFBOXER-FUNCTION BU:]-KEY COM-EXIT-BOX)
  153.  
  154. (DEFBOXER-FUNCTION BU:/(-KEY COM-MAKE-AND-ENTER-BOX)
  155.  
  156. (DEFBOXER-FUNCTION BU:/)-KEY COM-EXIT-BOX)
  157.  
  158. (DEFBOXER-FUNCTION BU:CTRL-/(-KEY COM-ENTER-BOX)
  159.  
  160. (DEFBOXER-FUNCTION BU:CTRL-/)-KEY COM-EXIT-BOX)
  161.  
  162. (DEFBOXER-FUNCTION BU:CTRL-[-KEY COM-ENTER-BOX)
  163.  
  164. (DEFBOXER-FUNCTION BU:CTRL-]-KEY COM-EXIT-BOX)
  165.  
  166. (DEFBOXER-FUNCTION BU:CTRL-<-KEY COM-COLLAPSE-BOX)
  167.  
  168. (DEFBOXER-FUNCTION BU:CTRL->-KEY COM-EXPAND-BOX)
  169.  
  170. (DEFBOXER-FUNCTION BU:CTRL-META-<-KEY COM-GOTO-TOP-LEVEL)
  171.  
  172. (DEFBOXER-FUNCTION CTRL-=-KEY COM-FIX-BOX-SIZE)
  173.  
  174. (DEFBOXER-FUNCTION META-=-KEY COM-UNFIX-BOX-SIZE)
  175.  
  176. (DEFBOXER-FUNCTION CTRL-+-KEY COM-MAKE-SHRINK-PROOF-SCREEN)
  177.  
  178. (DEFBOXER-FUNCTION META-+-KEY COM-UNSHRINK-PROOF-SCREEN)
  179.  
  180. (DEFBOXER-FUNCTION CTRL-SPACE-KEY COM-MAKE-PORT)
  181.  
  182. (DEFBOXER-FUNCTION META-SPACE-KEY COM-PLACE-PORT)
  183.  
  184. (DEFBOXER-FUNCTION META-RUBOUT-KEY COM-RUBOUT-WORD)
  185.  
  186. (DEFBOXER-FUNCTION META-D-KEY COM-DELETE-WORD)
  187.  
  188. #+CADR
  189. (DEFBOXER-FUNCTION BU:ALTMODE-KEY  COM-PROMPT)
  190. #+3600
  191. (DEFBOXER-FUNCTION BU:COMPLETE-KEY COM-PROMPT)
  192. #+(OR 3600 EXPLORER)
  193. (DEFBOXER-FUNCTION BU:ESCAPE-KEY   COM-PROMPT)
  194.  
  195. ;The 3600 lacks a status key, but has a LOCAL key which generates #\QUOTE
  196. #+3600
  197. (DEFBOXER-FUNCTION BU:CTRL-CIRCLE-KEY COM-EDIT-LOCAL-LIBRARY)
  198. #-3600 
  199. (DEFBOXER-FUNCTION BU:STATUS-KEY      COM-EDIT-LOCAL-LIBRARY)
  200. #+EXPLORER  
  201. (DEFBOXER-FUNCTION BU:CTRL-F3-KEY     COM-EDIT-LOCAL-LIBRARY)
  202.  
  203. (DEFBOXER-FUNCTION BU:HELP-KEY COM-HELP)
  204.  
  205. (DEFBOXER-FUNCTION CTRL-HELP-KEY COM-COMMAND-HELP)
  206.  
  207. (DEFBOXER-FUNCTION META-HELP-KEY COM-APROPOS-HELP)
  208.  
  209. (DEFBOXER-FUNCTION BU:END-KEY COM-DOIT)
  210.  
  211. (DEFBOXER-FUNCTION BU:CTRL-END-KEY COM-DOIT-NOW)
  212.  
  213. (DEFBOXER-FUNCTION BU:META-END-KEY COM-UNMARK-REGION)
  214.  
  215. (defboxer-function bu:line-key com-doit-now)
  216.  
  217. (DEFBOXER-FUNCTION BU:META-LINE-KEY com-doit-now-give-lispm-errors)
  218.  
  219. (define-key-name 'bu:step-key #-3600 #\MACRO
  220.                       #+3600 #\page)
  221.  
  222. (defboxer-function bu:step-key com-step-through-box)
  223.  
  224. #+3600
  225. (DEFBOXER-FUNCTION BU:SQUARE-KEY COM-MAKE-GRAPHICS-BOX)
  226. #+EXPLORER
  227. (DEFBOXER-FUNCTION BU:F1-KEY     COM-MAKE-GRAPHICS-BOX)
  228.  
  229. #+3600
  230. (DEFBOXER-FUNCTION BU:CTRL-SQUARE-KEY COM-MAKE-GRAPHICS-DATA-BOX)
  231. #+EXPLORER
  232. (DEFBOXER-FUNCTION BU:CTRL-F1-KEY     COM-MAKE-GRAPHICS-DATA-BOX) 
  233.  
  234. #+3600
  235. (DEFBOXER-FUNCTION BU:TRIANGLE-KEY COM-MAKE-SPRITE-BOX)
  236. #+EXPLORER
  237. (DEFBOXER-FUNCTION BU:F2-KEY       COM-MAKE-SPRITE-BOX)
  238.  
  239. (DEFBOXER-FUNCTION BU:CTRL-CLEAR-INPUT-KEY ()    
  240.   (COM-TOGGLE-INTO-GRAPHICS-BOX))
  241.  
  242. ;;;strange lossage where CTRL-CLEAR-INPUT isn't being tyi'd
  243. #+EXPLORER
  244. (DEFBOXER-FUNCTION BU:META-F1-KEY COM-TOGGLE-INTO-GRAPHICS-BOX)
  245.  
  246. (setq WHO-LINE-DOCUMENTATION-STRING
  247. "L:Make Box Smaller, L2:Make Box Tiny, M:Move To Box, R:Make Box Larger, R2:Make Box Full Screen")
  248.  
  249. (DEFBOXER-FUNCTION MOUSE-LEFT-ONCE (WINDOW X Y)
  250.   (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
  251.     (IF (NOT (NULL SPRITE))
  252.     (COM-SPRITE-LEFT-CLICK SPRITE)
  253.     (COM-MOUSE-COLLAPSE-BOX WINDOW X Y))))
  254.  
  255. (DEFBOXER-FUNCTION MOUSE-RIGHT-ONCE (WINDOW X Y)
  256.   (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
  257.     (IF (NOT (NULL SPRITE))
  258.     (COM-SPRITE-RIGHT-CLICK SPRITE)
  259.     (COM-MOUSE-EXPAND-BOX WINDOW X Y))))
  260.  
  261. (DEFBOXER-FUNCTION MOUSE-MIDDLE-ONCE (WINDOW X Y)
  262.   (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
  263.     (IF (NOT (NULL SPRITE))
  264.     (COM-SPRITE-MIDDLE-CLICK SPRITE)
  265.     (COM-MOUSE-MOVE-POINT WINDOW X Y))))
  266.  
  267. (DEFBOXER-FUNCTION MOUSE-LEFT-TWICE (WINDOW X Y)
  268.   (COM-MOUSE-SHRINK-BOX WINDOW X Y))
  269.  
  270. (DEFBOXER-FUNCTION MOUSE-RIGHT-TWICE (WINDOW X Y)
  271.   (COM-MOUSE-SET-OUTERMOST-BOX WINDOW X Y))
  272.  
  273. (DEFBOXER-FUNCTION MOUSE-MIDDLE-DOWN (WINDOW X Y)
  274.   (LET ((SPRITE (TELL *SPRITE-BLINKER* :SELECTED-SPRITE)))
  275.     (IF (NOT (NULL SPRITE))
  276.         (COM-MOUSE-GRAB-SPRITE SPRITE)
  277.         (COM-MOUSE-DEFINE-REGION WINDOW X Y))))
  278.  
  279. (DEFBOXER-FUNCTION MOUSE-MIDDLE-UP (WINDOW X Y)
  280.   (COM-MOUSE-RELEASE-REGION WINDOW X Y))
  281.  
  282. (COMMENT
  283.  
  284. (DEFBOXER-FUNCTION MOUSE-LEFT-ONCE (WINDOW X Y)
  285.   (COM-MOUSE-FANCY-LEFT WINDOW X Y))
  286.  
  287. (DEFBOXER-FUNCTION MOUSE-RIGHT-ONCE (WINDOW X Y)
  288.   (COM-MOUSE-FANCY-UP WINDOW X Y))
  289.  
  290. (DEFVAR MOUSE-FANCY-LEFT-DIRECTION -1)
  291. (DEFVAR MOUSE-FANCY-UP-DIRECTION -1)
  292.  
  293. (DEFUN  MOUSE-FANCY-LEFT-COMPLEMENT-DIRECTION ()
  294.   (IF (MINUSP MOUSE-FANCY-LEFT-DIRECTION)
  295.       (SETQ MOUSE-FANCY-LEFT-DIRECTION 1)
  296.       (SETQ MOUSE-FANCY-LEFT-DIRECTION -1)))
  297.  
  298. (DEFUN  MOUSE-FANCY-UP-COMPLEMENT-DIRECTION ()
  299.   (IF (MINUSP MOUSE-FANCY-UP-DIRECTION)
  300.       (SETQ MOUSE-FANCY-UP-DIRECTION 1)
  301.       (SETQ MOUSE-FANCY-UP-DIRECTION -1)))
  302.  
  303. (DEFUN  COM-MOUSE-FANCY-LEFT (&REST IGNORE)
  304.   (MOUSE-FANCY-MOVE)
  305.   (MOUSE-FANCY-LEFT-COMPLEMENT-DIRECTION))
  306.  
  307. (DEFUN  COM-MOUSE-FANCY-UP (&REST IGNORE)
  308.   (MOUSE-FANCY-MOVE)
  309.   (MOUSE-FANCY-UP-COMPLEMENT-DIRECTION))
  310.  
  311. (DEFUN MOUSE-FANCY-MOVE (&REST IGNORE)
  312.   (LET ((DELTA 2))
  313.     (LOOP UNTIL (ZEROP TV:MOUSE-LAST-BUTTONS)
  314.       DO (TV:MOUSE-WARP (IF (BIT-TEST #O1 TV:MOUSE-LAST-BUTTONS)
  315.                 (FIX (+ TV:MOUSE-X (* MOUSE-FANCY-LEFT-DIRECTION DELTA)))
  316.                 TV:MOUSE-X)
  317.                 (IF (BIT-TEST #O4 TV:MOUSE-LAST-BUTTONS)
  318.                 (FIX (+ TV:MOUSE-Y (* MOUSE-FANCY-UP-DIRECTION DELTA)))
  319.                 TV:MOUSE-Y))
  320.          (SETQ DELTA (MIN 24. (* 2 DELTA)))
  321.          (PROCESS-WAIT "Sleep"
  322.                #'(LAMBDA (WAKEUP) (OR (> (TIME) WAKEUP)
  323.                           (ZEROP TV:MOUSE-LAST-BUTTONS)))
  324.                (+ (TIME) 20.)))))
  325.  
  326. )
  327.